Enigma Amiga Life 109/EnigmaAmiga109CD.iso/dalla rivista/amiga.free/sorgenti vari/wolfedit2 2.0.4 source.sit/WolfEdit2 2.0.4 Source/UMultiArt.p

Text File | 1996-06-14 | 13KB | 564 lines

unit UMultiArt;

interface
    uses
        UWolfDoc;

    type

        MultiArtType = (bjArt, faceArt320, faceArt512, faceArt640);

    procedure EditMultiArt (doc: TMapListDoc; which: MultiArtType);

implementation
    uses
        UList, UXWindow, UScrap, UPixMapView, ULZSS, UCTables, UMemory;

    const

        maxMAImages = 60;
        multiArtWindID = 134;
        bjImageNamesID = 128;
        faceImageNamesID = 129;
        outOfMemAlrtID = 148;

    type

        LongintPtr = ^longint;
        MAIndexArray = array[1..maxMAImages] of longint;
        MAIndexPtr = ^MAIndexArray;

        PairPtr = ^Pair;
        Pair = record
                x, y: integer;
            end;

        MAImageRecord = record
                frame: Rect;
                bounds: Rect;
                masked: boolean;
                data: Handle;
            end;

        TMultiArtWindow = object(TXWindow)
                fType: MultiArtType;
                fMapList: TMapListDoc;
                fNumImages: integer;
                fImages: array[1..maxMAImages] of MAImageRecord;
                fChanged: boolean;
                fCurrentImage: integer;
                fMAList: TMAList;
                fImageView: TPixMapView;
                fCTab: CTabHandle;
                fIntermissionCTab: CTabHandle;
                fSizeView: TMASizeView;
                procedure IMultiArtWindow (itsDoc: TMapListDoc; itsType: MultiArtType);
                procedure Free;
                override;
                procedure SetupMenus;
                override;
                procedure DoMenuCommand (cmdNumber: integer);
                override;
                procedure DoCopy;
                procedure DoPaste;
                procedure InstallBrgr (brgr: Handle);
                procedure SelectImage (n: integer);
                procedure ShowImage;
                procedure FlushImage;
                procedure HideImage;
                function Changed: boolean;
                override;
                function Flush: boolean;
                override;
                procedure UpdateTitle;
                override;
            end;

        TMAList = object(TList)
                fMAWindow: TMultiArtWindow;
                procedure DrawCell (cell: Point; r: Rect; var hilite: boolean);
                override;
                procedure SetSelectionRect (newSel: Rect);
                override;
            end;

        TMASizeView = object(TView)
                fMAWindow: TMultiArtWindow;
                procedure IMASizeView (itsWin: TMultiArtWindow);
                procedure Draw;
                override;
            end;

    procedure OutOfMemory;
    begin
        DoAlert(outOfMemAlrtID);
    end;

    function GetMABrgrID (artType: MultiArtType): integer;
    begin
        GetMABrgrID := 141 + ord(artType);
    end;

    function GetMACTabID (itsType: MultiArtType): integer;
    begin
        if itsType = bjArt then
            GetMACTabID := intermissionCTabID
        else
            GetMACTabID := gameCTabID;
    end;

    function GetNumImages (artType: MultiArtType): integer;
    begin
        case artType of
            bjArt:
                GetNumImages := 3;
            faceArt512:
                GetNumImages := 57;
            otherwise
                GetNumImages := 47;
        end;
    end;

    procedure GetImageName (artType: MultiArtType; i: integer; var s: Str255);
        var
            id: integer;
    begin
        case artType of
            bjArt:
                id := bjImageNamesID;
            otherwise
                id := faceImageNamesID;
        end;
        GetIndString(s, id, i);
    end;

    function ImageHasMask (itsType: MultiArtType; i: integer): boolean;
    begin
        if itsType = bjArt then
            ImageHasMask := false
        else
            case i of
                13..36:
                    ImageHasMask := true;
                otherwise
                    ImageHasMask := false;
            end;
    end;

    procedure SetImageFrame (var frame: Rect; artType: MultiArtType; masked: boolean; dim: Pair);
    begin
        if masked then
            case artType of
                faceArt320:
                    SetRect(frame, 0, 0, 64, 64);
                faceArt512:
                    SetRect(frame, 0, 0, 102, 102);
                faceArt640:
                    SetRect(frame, 0, 0, 128, 128);
            end
        else
            SetRect(frame, 0, 0, dim.x, dim.y);
    end;

    procedure TMAList.DrawCell (cell: Point; r: Rect; var hilite: boolean);
        var
            name: Str255;
    begin
        TextFont(geneva);
        TextSize(9);
        if hilite then begin
                FillRect(r, black);
                TextMode(srcBic);
            end
        else begin
                EraseRect(r);
                TextMode(srcOr);
            end;
        MoveTo(r.left + 5, r.bottom - 3);
        GetImageName(fMAWindow.fType, cell.v + 1, name);
        DrawString(name);
        hilite := false;
    end;

    procedure TMAList.SetSelectionRect (newSel: Rect);
    begin
        inherited SetSelectionRect(newSel);
        fMAWindow.SelectImage(fSelection.bottom);
    end;

    procedure TMASizeView.IMASizeView (itsWin: TMultiArtWindow);
        var
            r: Rect;
    begin
        SetRect(r, 0, 0, 300, 16);
        IView(nil, nil, r);
        fMAWindow := itsWin;
    end;

    procedure TMASizeView.Draw;
    begin
        EraseRect(fExtent);
        with fMAWindow do begin
                if fCurrentImage > 0 then begin
                        TextFont(geneva);
                        TextSize(9);
                        MoveTo(0, fExtent.bottom - 4);
                        with fImages[fCurrentImage] do begin
                                WriteDraw('Size: ', bounds.right - bounds.left : 1, 'x', bounds.bottom - bounds.top : 1);
                                if masked then
                                    WriteDraw(' (max ', frame.right : 1, 'x', frame.bottom : 1, ')');
                                if masked then
                                    WriteDraw('  Offset: ', bounds.left - frame.left : 1, ',', bounds.top - frame.top : 1);
                            end;
                    end;
            end;
    end;

    procedure TMultiArtWindow.IMultiArtWindow (itsDoc: TMapListDoc; itsType: MultiArtType);
        var
            brgrID: integer;
            brgr: Handle;
            cTabID: integer;
            maList: TMAList;
            sizeView: TMASizeView;
    begin
        fType := itsType;
        fMapList := itsDoc;
        IGetNewCWindow(itsDoc, multiArtWindID, [wCloseOnGoAway]);
        fNumImages := GetNumImages(fType);
        fChanged := false;
        fImageView := nil;
        cTabID := GetMACTabID(fType);
        fCTab := GetMapListCTab(itsDoc, cTabID);
        fIntermissionCTab := GetMapListCTab(itsDoc, intermissionCTabID);
        new(maList);
        maList.IList(150, 12, 1, fNumImages, 0, []);
        fMAList := maList;
        fMAList.fMAWindow := self;
        Place(fMAList, nil, nil, 10, 10, natural, 300, [frmBorder, frmVScroll]);
        fMAList.fFrame.fLineSize.v := 12;
        new(sizeView);
        sizeView.IMASizeView(self);
        fSizeView := sizeView;
        Place(fSizeView, fMAList, nil, 25, 10, natural, natural, []);
        brgrID := GetMABrgrID(fType);
        brgr := fMapList.GetMiscBrgr(brgrID);
        if brgr = nil then
            brgr := GetResource('BRGR', brgrID);
        InstallBrgr(brgr);
    end;

    procedure TMultiArtWindow.Free;
        var
            i: integer;
    begin
        for i := 1 to fNumImages do begin
{writeln('TMultiArtWindow.Free: DisposHandle(fImages[i].data)', GetHandleSize(fImages[i].data));    {***}
                DisposHandle(fImages[i].data);
            end;
{writeln('TMultiArtWindow.Free: DisposHandle(fCTab)', GetHandleSize(Handle(fCTab)));}
        DisposHandle(Handle(fCTab));
{writeln('TMultiArtWindow.Free: DisposHandle(fIntermissionCTab)', GetHandleSize(Handle(fIntermissionCTab)));}
        DisposHandle(Handle(fIntermissionCTab));
        inherited Free;
    end;

    procedure TMultiArtWindow.SetupMenus;
    begin
        inherited SetupMenus;
        if fCurrentImage > 0 then begin
                EnableCmd(copyCmd);
                if ProbeScrap('PICT') then
                    EnableCmd(pasteCmd);
            end;
    end;

    procedure TMultiArtWindow.DoMenuCommand (cmdNumber: integer);
    begin
        case cmdNumber of
            copyCmd:
                DoCopy;
            pasteCmd:
                DoPaste;
            otherwise
                inherited DoMenuCommand(cmdNumber);
        end;
    end;

    procedure TMultiArtWindow.DoCopy;
    begin
        fImageView.DoCopy;
    end;

    procedure TMultiArtWindow.DoPaste;
        var
            pict: PicHandle;
            width, height: longint;
    begin
        ReadScrap('PICT', pict);
        if pict <> nil then begin
                with pict^^.picFrame do begin
                        width := right - left;
                        height := bottom - top;
                    end;
                DisposHandle(Handle(pict));
                SetHandleSize(fImages[fCurrentImage].data, width * height);
                if MemError <> noErr then begin
                        OutOfMemory;
                        exit(DoPaste);
                    end;
                HideImage;
                with fImages[fCurrentImage] do begin
                        SetRect(bounds, 0, 0, width, height);
                        if masked then
                            OffsetRect(bounds, (frame.right - width) div 2, frame.bottom - height)
                        else
                            frame := bounds;
                    end;
                ShowImage;
                fImageView.DoPaste;
                fChanged := true;
                fMapList.Changed;
            end;
    end;

    procedure TMultiArtWindow.InstallBrgr (brgr: Handle);
        var
            bufSize, dataSize: longint;
            src, buf, p: Ptr;
            index: MAIndexPtr;
            dim, offset: Pair;
            i: integer;
            hasMask: boolean;
            data: Handle;
    begin
        HLock(brgr);
        bufSize := LongintPtr(brgr^)^;
{writeln('TMultiArtWindow.InstallBrgr: NewPtr', bufSize);    {***}
        buf := NewPtr(bufSize);
        src := Ptr(ord(brgr^) + 4);
        DLZSS(src, buf, bufSize);
        HUnlock(brgr);
        index := MAIndexPtr(buf);
        for i := 1 to fNumImages do begin
                p := Ptr(ord(buf) + index^[i]);
                hasMask := ImageHasMask(fType, i);
                if hasMask then begin
                        offset := PairPtr(p)^;
                        p := Ptr(ord(p) + 4);
                    end;
                dim := PairPtr(p)^;
                p := Ptr(ord(p) + 4);
                if not hasMask then begin
                        offset.x := 0;
                        offset.y := 0;
                    end;
 {$IFC FALSE}
                write(i, index^[i], dim.x : 1, '*', dim.y : 1);
                if hasMask then
                    write('+', offset.x : 1, ',', offset.y : 1);
                writeln;
 {$ENDC}
                dataSize := longint(dim.x) * longint(dim.y);
                data := NewHandle(dataSize);
{writeln('TMultiArtWindow.InstallBrgr: NewHandle', dataSize);    {***}
                BlockMove(Ptr(p), data^, dataSize);
                with fImages[i] do begin
                        masked := hasMask;
                        SetImageFrame(frame, fType, masked, dim);
                        SetRect(bounds, offset.x, offset.y, offset.x + dim.x, offset.y + dim.y);
                    end;
                fImages[i].data := data;
            end;
        DisposPtr(buf);
    end;

    function TMultiArtWindow.Changed: boolean;
    begin
        Changed := fChanged;
    end;

    function TMultiArtWindow.Flush: boolean;
        var
            bufSize, dataSize: longint;
            i: integer;
            buf, p, q: Ptr;
            index: MAIndexPtr;
            brgr: Handle;
            dim, offset: Pair;

        procedure Abort;
        begin
            DisposPtr(buf);
            Flush := false;
            exit(Flush);
        end;

{$D-}
        procedure PutMask;
        begin
            while dataSize > 0 do begin
                    if q^ = 0 then
                        p^ := -1
                    else
                        p^ := 0;
                    p := Ptr(ord(p) + 1);
                    q := Ptr(ord(q) + 1);
                    dataSize := dataSize - 1;
                end;
        end;
{$D+}

    begin {TMultiArtWindow.Flush}
        buf := nil;
        if fChanged then begin
                FlushImage;
                bufSize := 0;
                for i := 1 to fNumImages do
                    with fImages[i] do begin
                            bufSize := bufSize + 8; {index entry + dimensions}
                            if masked then
                                bufSize := bufSize + 4; {offset}
                            dataSize := GetHandleSize(data);
                            if masked then
                                dataSize := dataSize * 2;
                            bufSize := bufSize + dataSize;
                        end;
                buf := NewPtr(bufSize);
{writeln('TMultiArtWindow.Flush: NewPtr', bufSize);    {***}
                if buf = nil then begin
                        OutOfMemory;
                        Abort;
                    end;
                index := MAIndexPtr(buf);
                p := Ptr(ord(buf) + 4 * fNumImages);
                for i := 1 to fNumImages do begin
                        index^[i] := ord(p) - ord(buf);
                        with fImages[i] do begin
                                dim.x := bounds.right - bounds.left;
                                dim.y := bounds.bottom - bounds.top;
                                offset.x := bounds.left - frame.left;
                                offset.y := bounds.top - frame.top;
                                if masked then begin
                                        PairPtr(p)^ := offset;
                                        p := Ptr(ord(p) + 4);
                                    end;
                                PairPtr(p)^ := dim;
                                p := Ptr(ord(p) + 4);
                                dataSize := GetHandleSize(data);
                                BlockMove(data^, p, dataSize);
                                p := Ptr(ord(p) + dataSize);
                                if masked then begin
                                        q := data^;
                                        PutMask;
                                    end;
                            end;
                    end;
                brgr := LZSSX(4, nil, 0, buf, bufSize, false);
                if brgr = nil then
                    Abort;
                LongintPtr(brgr^)^ := bufSize;
{writeln('TMultiArtWindow.Flush: DisposPtr(buf)', GetHandleSize(buf));    {***}
                DisposPtr(buf);
                fMapList.InstallMiscBrgr(brgr, GetMABrgrID(fType));
                fChanged := false;
            end; {if fChanged}
        Flush := true;
    end; {TMultiArtWindow.Flush}

    procedure TMultiArtWindow.SelectImage (n: integer);
    begin
        if n <> fCurrentImage then begin
                HideImage;
                fCurrentImage := n;
                ShowImage;
                fSizeView.Invalidate;
            end;
    end;

    procedure TMultiArtWindow.ShowImage;
        var
            pixels: Ptr;
            i: integer;
            imageView: TPixMapView;
            cTab: CTabHandle;
    begin
        if fCurrentImage > 0 then begin
                i := fCurrentImage;
                if i > 47 then
                    cTab := fIntermissionCTab
                else
                    cTab := fCTab;
                new(imageView);
                imageView.IPixMapViewX(fImages[i].frame, fImages[i].bounds, cTab);
                fImageView := imageView;
                pixels := GetPixBaseAddr(fImageView.fPixMap);
                BlockMove(fImages[i].data^, pixels, GetHandleSize(fImages[i].data));
                Place(fImageView, fMAList, fSizeView, 25, 10, natural, natural, [frmBorder]);
                fImageView.fNextHandler := nil;
            end;
    end;

    procedure TMultiArtWindow.FlushImage;
        var
            pixels: Ptr;
            i: integer;
    begin
        if (fImageView <> nil) & (fImageView.fChanged) then begin
                i := fCurrentImage;
                pixels := GetPixBaseAddr(fImageView.fPixMap);
                BlockMove(pixels, fImages[i].data^, GetHandleSize(fImages[i].data));
                fChanged := true;
            end;
    end;

    procedure TMultiArtWindow.HideImage;
    begin
        FlushImage;
        if fImageView <> nil then begin
                fImageView.fFrame.Free;
                fImageView := nil;
            end;
    end;

    procedure TMultiArtWindow.UpdateTitle;
        var
            what: string;
    begin
        case fType of
            bjArt:
                what := 'Intermission Animation';
            faceArt320:
                what := 'Interface Art 320';
            faceArt512:
                what := 'Interface Art 512';
            faceArt640:
                what := 'Interface Art 640';
        end;
        SetTitle(concat(what, ' from ', fMapList.fFileName));
    end;

    procedure EditMultiArt (doc: TMapListDoc; which: MultiArtType);
        var
            win: TWindow;
            maWin: TMultiArtWindow;

        procedure TestWindow (win: TWindow);
        begin
            if member(win, TMultiArtWindow) then
                if TMultiArtWindow(win).fType = which then begin
                        win.Select;
                        exit(EditMultiArt);
                    end;
        end;

    begin {EditMultiArt}
        doc.EachWindowDo(TestWindow);
        if EnoughMemory($80000) then begin
                new(maWin);
                maWin.IMultiArtWindow(doc, which);
                maWin.Select;
            end;
    end;

end.